unit LogErrors;

interface

uses SysUtils;

const
  INTERNAL_ERROR = -1;

  FATAL_OPEN_FILE_FAILS =   1;
  FATAL_READ_FILE_FAILS =   2;
  FATAL_LAST_CODE       = 999;


  ERROR_KEYWORD_EXPECTED                   = $1001;
  ERROR_OPTION_NAME_OR_FOR_EXPECTED        = $1002;
  ERROR_OPTION_LANG_NAME_EXPECTED          = $1003;
  ERROR_OPTION_NAME_EXPECTED               = $1004;
  ERROR_OPTION_EQ_EXPECTED                 = $1005;
  ERROR_TYPE_NAME_EXPECTED                 = $1006;
  ERROR_TYPE_NO_EOL                        = $1007;
  ERROR_TYPE_UNKNOWN                       = $1008;
  ERROR_TYPE_UNSUPPORTED_INT_SIZE          = $1009;
  ERROR_TYPE_FOR_FLOATS_NO_SIZE            = $100A;
  ERROR_TYPE_FOR_DATES_NO_SIZE             = $100B;
  ERROR_TYPE_FOR_GUID_NO_SIZE              = $100C;
  ERROR_FIELD_TYPE_SIZE_EXPECTED           = $100D;
  ERROR_FIELD_TYPE_SIZE_RBRACKER_EXPECTED  = $100E;
  ERROR_FIELD_IS_NOT_INSIDE_TYPE           = $100F;
  ERROR_FIELD_AFTER_INDEXED_EXPECTED       = $1010;
  ERROR_FIELD_ID_EXPECTED                  = $1011;
  ERROR_FIELD_COLON_EXPECTED               = $1012;
  ERROR_FIELD_TYPE_EXPECTED                = $1013;
  ERROR_FIELD_NO_EOL                       = $1014;

type
  TErrorItem = class
    Code: Integer;
    Msg: string;
    Col, Line: Integer;
    function Format(): string;
  end;

  EBaseError = class(Exception)
    Code: Integer;
    Line, Col: Integer;
    function CreateErrorItem(): TErrorItem;
  end;

  EFatalError = class(EBaseError) end;
  EParseError = class(EBaseError) end;
  EInternalError = class(EFatalError) end;
  EBaseErrorClass = class of EBaseError;


procedure BaseError(ErrorClass: EBaseErrorClass; Code: Integer); overload;
procedure BaseError(ErrorClass: EBaseErrorClass; Code, Line, Col: Integer); overload;
procedure BaseError(ErrorClass: EBaseErrorClass; Code: Integer; const Args: array of const); overload;
procedure BaseError(ErrorClass: EBaseErrorClass; Code: Integer; const Args: array of const; Line, Col: Integer); overload;

procedure ParseError(Code: Integer); overload;
procedure ParseError(Code, Line, Col: Integer); overload;
procedure ParseError(Code: Integer; const Args: array of const); overload;
procedure ParseError(Code: Integer; const Args: array of const; Line, Col: Integer); overload;

procedure ParseCheck(Assertion: Boolean; Code: Integer); overload;
procedure ParseCheck(Assertion: Boolean; Code, Line, Col: Integer); overload;
procedure ParseCheck(Assertion: Boolean; Code: Integer; const Args: array of const); overload;
procedure ParseCheck(Assertion: Boolean; Code: Integer; const Args: array of const; Line, Col: Integer); overload;

procedure FatalError(Code: Integer); overload;
procedure FatalError(Code, Line, Col: Integer); overload;
procedure FatalError(Code: Integer; const Args: array of const); overload;
procedure FatalError(Code: Integer; const Args: array of const; Line, Col: Integer); overload;

procedure InternalError(const Description: string); overload;
procedure InternalError(const Description: string; const Args: array of const); overload;

function FormatError(ErrorItem: TErrorItem): string;

implementation

uses LogLexer;

type
  TErrorMessage = record
    Code: Integer;
    Msg: string;
  end;

var
  ErrorMessages: array[1..23] of TErrorMessage =
    ((
      Code: INTERNAL_ERROR;
      Msg: 'Internal error: %s.';
    ),(
      Code: FATAL_OPEN_FILE_FAILS;
      Msg: 'Fatal Error: Open file "%s" error: code = %d, description = %s.';
    ),(
      Code: FATAL_READ_FILE_FAILS;
      Msg: 'Fatal Error: Reading file error: code = %d, description = %s.';
    ),(
      Code: ERROR_KEYWORD_EXPECTED;
      Msg: '%s keywords expected.';
    ),(
      Code: ERROR_OPTION_NAME_OR_FOR_EXPECTED;
      Msg: 'Option name (identifier) or FOR clause excepted.';
    ),(
      Code: ERROR_OPTION_LANG_NAME_EXPECTED;
      Msg: 'Option language specifier expected.';
    ),(
      Code: ERROR_OPTION_NAME_EXPECTED;
      Msg: 'Option name (identifier) expected.';
    ),(
      Code: ERROR_OPTION_EQ_EXPECTED;
      Msg: '"=" symbol expected.';
    ),(
      Code: ERROR_TYPE_NAME_EXPECTED;
      Msg: 'Log type name expected.';
    ),(
      Code: ERROR_TYPE_NO_EOL;
      Msg: 'Log type declaration complete, but EOL is not found.';
    ),(
      Code: ERROR_TYPE_UNKNOWN;
      Msg: 'Unknown type.';
    ),(
      Code: ERROR_TYPE_UNSUPPORTED_INT_SIZE;
      Msg: 'Unsupported size value for integer field.';
    ),(
      Code: ERROR_TYPE_FOR_FLOATS_NO_SIZE;
      Msg: 'Field size is not applicable for float types.';
    ),(
      Code: ERROR_TYPE_FOR_DATES_NO_SIZE;
      Msg: 'Field size is not applicable for date and time types.';
    ),(
      Code: ERROR_TYPE_FOR_GUID_NO_SIZE;
      Msg: 'Field size is not applicable for guid.';
    ),(
      Code: ERROR_FIELD_TYPE_SIZE_EXPECTED;
      Msg: 'Error in field type: size modifier expected.';
    ),(
      Code: ERROR_FIELD_TYPE_SIZE_RBRACKER_EXPECTED;
      Msg: '"]" expected.';
    ),(
      Code: ERROR_FIELD_IS_NOT_INSIDE_TYPE;
      Msg: 'Fields can be declared only inside TYPE declaration.';
    ),(
      Code: ERROR_FIELD_AFTER_INDEXED_EXPECTED;
      Msg: 'FIELD keyword expected.';
    ),(
      Code: ERROR_FIELD_ID_EXPECTED;
      Msg: 'Field name expected.';
    ),(
      Code: ERROR_FIELD_COLON_EXPECTED;
      Msg: 'Colon after field name expected.';
    ),(
      Code: ERROR_FIELD_TYPE_EXPECTED;
      Msg: 'Field type expected.';
    ),(
      Code: ERROR_FIELD_NO_EOL;
      Msg: 'Field definition complete, but EOL is not found.';



{
    ),(
      Code: ;
      Msg: '';
}
    ));

procedure QuickSort(L, R: Integer);
var
  I, J: Integer;
  P, T: TErrorMessage;
begin
  repeat
    I := L;
    J := R;
    P := ErrorMessages[(L + R) div 2];
    repeat
      while ErrorMessages[I].Code < P.Code do I := I + 1;
      while ErrorMessages[J].Code > P.Code do J := J - 1;
      if I <= J then
      begin
        T := ErrorMessages[I];
        ErrorMessages[I] := ErrorMessages[J];
        ErrorMessages[J] := T;
        I := I + 1;
        J := J - 1;
      end;
    until I > J;
    if L < J then QuickSort(L, J);
    L := I;
  until I >= R;
end;

procedure Sort();
begin
  QuickSort(Low(ErrorMessages), High(ErrorMessages));
end;

function GetMessage(Code: Integer): string;
var
  L, H, I: Integer;
begin
  Result := '';
  L := Low(ErrorMessages);
  H := High(ErrorMessages);
  while L <= H do
  begin
    I := (L + H) div 2;
    if ErrorMessages[I].Code = Code then
    begin
      Result := ErrorMessages[I].Msg;
      Exit;
    end;

    if ErrorMessages[I].Code < Code
      then L := I + 1
      else H := I - 1
  end;
end;

function EBaseError.CreateErrorItem(): TErrorItem;
begin
  Result := TErrorItem.Create();
  Result.Code := Code;
  Result.Line := Line;
  Result.Col := Col;
  Result.Msg := Message;
end;



procedure BaseError(ErrorClass: EBaseErrorClass; Code: Integer);
begin
  BaseError(ErrorClass, Code, LogLexer.Line, LogLexer.Column);
end;

procedure BaseError(ErrorClass: EBaseErrorClass; Code, Line, Col: Integer);
var
  E: EBaseError;
begin
  E := ErrorClass.Create(GetMessage(Code));
  E.Code := Code;
  E.Line := Line;
  E.Col := Col;
  raise E;
end;

procedure BaseError(ErrorClass: EBaseErrorClass; Code: Integer; const Args: array of const);
begin
  BaseError(ErrorClass, Code, Args, -1, -1);
end;

procedure BaseError(ErrorClass: EBaseErrorClass; Code: Integer; const Args: array of const; Line, Col: Integer);
var
  E: EBaseError;
begin
  E := ErrorClass.CreateFmt(GetMessage(Code), Args);
  E.Code := Code;
  E.Line := Line;
  E.Col := Col;
  raise E;
end;



procedure ParseError(Code: Integer); overload;
begin
  BaseError(EParseError, Code);
end;

procedure ParseError(Code, Line, Col: Integer); overload;
begin
  BaseError(EParseError, Code, Line, Col);
end;

procedure ParseError(Code: Integer; const Args: array of const); overload;
begin
  BaseError(EParseError, Code, Args);
end;

procedure ParseError(Code: Integer; const Args: array of const; Line, Col: Integer); overload;
begin
  BaseError(EParseError, Code, Args, Line, Col);
end;



procedure ParseCheck(Assertion: Boolean; Code: Integer); overload;
begin
  if Assertion = False then
    ParseError(Code); 
end;

procedure ParseCheck(Assertion: Boolean; Code, Line, Col: Integer); overload;
begin
  if Assertion = False then
    ParseError(Code, Line, Col); 
end;

procedure ParseCheck(Assertion: Boolean; Code: Integer; const Args: array of const); overload;
begin
  if Assertion = False then
    ParseError(Code, Args);
end;

procedure ParseCheck(Assertion: Boolean; Code: Integer; const Args: array of const; Line, Col: Integer); overload;
begin
  if Assertion = False then
    ParseError(Code, Args, Line, Col); 
end;



procedure FatalError(Code: Integer); overload;
begin
  BaseError(EFatalError, Code);
end;

procedure FatalError(Code, Line, Col: Integer); overload;
begin
  BaseError(EFatalError, Code, Line, Col);
end;

procedure FatalError(Code: Integer; const Args: array of const); overload;
begin
  BaseError(EFatalError, Code, Args);
end;

procedure FatalError(Code: Integer; const Args: array of const; Line, Col: Integer); overload;
begin
  BaseError(EFatalError, Code, Args, Line, Col);
end;



procedure InternalError(const Description: string); overload;
begin
  BaseError(EInternalError, INTERNAL_ERROR, [Description]);
end;

procedure InternalError(const Description: string; const Args: array of const); overload;
begin
  InternalError(Format(Description, Args));
end;




function TErrorItem.Format(): string;
begin
  if Code < 0 then
  begin
    Result := 'Internal error: ' + Msg;
    Exit;
  end;

  if Code <= FATAL_LAST_CODE
    then Result := 'Fatal error with code ' + IntToStr(Code)
    else Result := 'Error with code 0x' + IntToHex(Code, 4)
  ;

  if Line <> -1 then Result := Result + ' at line ' + IntToStr(Line);
  if Col <> -1 then Result := Result + ', column ' + IntToStr(Col);
  Result := Result + ': ' + Msg;
end;

function FormatError(ErrorItem: TErrorItem): string;
begin
  Result := ErrorItem.Format();
end;


procedure Init();
begin
  Sort();
end;

procedure Done();
begin
end;

initialization
  Init();

finalization
  Done();

end.